home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / mp_main.m < prev    next >
Text File  |  1992-05-12  |  13KB  |  497 lines
  1. /*
  2.  *    Plurals
  3.  *
  4.  *    Author:    S.C.Merrall
  5.  *
  6.  *    File:    mp_main.m
  7.  *
  8.  *    Contents:    mp_main    
  9.  *            mp_init
  10.  *            load_plural
  11.  *
  12.  *    Description:    To remove the need for a sepaerate plural wrapper
  13.  *            for each primitive supplied all functions executed
  14.  *            via this function which can take a variable number
  15.  *            of arguments and reduces the code size
  16.  *
  17.  *    Change History:
  18.  *
  19.  *    Date   Name Comment
  20.  *    -------- ---- -------
  21.  *    29:04:91 SCM  Created
  22.  *    16:05:91 SCM  Renamed from mp_lispobject.m to mp_main.m
  23.  *    16:05:91 SCM  Renamed mp_lispop to mp_main
  24.  *    16:05:91 SCM  Moved load_plural from mp_vax_comms.m
  25.  *    17:05:91 SCM  Added mp_init
  26.  *
  27.  */
  28.  
  29. #include <mpl.h>
  30. #include <stdio.h>
  31.  
  32. #include "constant.h"
  33.  
  34. #include "mp_object.h"
  35. #include "mp_debug.h"
  36. #include "mp_mem_mgmt.h"
  37. #include "mp_main.h"
  38. #include "mp_gc.h"
  39. #include "mp_op_id.h"
  40.  
  41. #define DEBUG(x) x
  42.  
  43. plural natural context_stack;
  44.  
  45. /*----------------------------------------------------------------------------*
  46.  * Function   : mp_init
  47.  *
  48.  * Parameters : void
  49.  *
  50.  * Description:    Creates base of context stack
  51.  *
  52.  * Result     : int:    FAIL/SUCCESS
  53.  *---------------------------------------------------------------------------*/
  54.  
  55. #ifdef __STDC__
  56.  
  57. visible int mp_init( void )
  58.  
  59. #else
  60.  
  61. visible int mp_init( )
  62.  
  63. #endif
  64.  
  65. {
  66.   MP_PluralHeap MPPH_context_stack;
  67.   MP_PluralHeap MPPH_true;
  68.   MP_PluralHeap MPPH_nil;
  69.   plural natural true;
  70.   plural natural nil;
  71. DBG_CALL("mp_init");
  72. DBG_ARGS(fprintf(dbg,"void"));
  73.  
  74.   OA_to_offsets(MPPH_true) = &true;
  75.   OA_to_offsets(MPPH_nil) = &nil;
  76.   OA_to_offsets(MPPH_context_stack) = &context_stack;
  77.  
  78.   if (make_integer(MPPH_true) == FAIL) {
  79.  
  80. DBG_FAIL(fprintf(dbg,"FAIL: Unable to make true for context stack base"));
  81.     return FAIL;
  82.   }
  83.   
  84.   *(plural int *plural) OA_data(MPPH_true) = (plural natural) 1;
  85.   nil = (plural natural) NIL;
  86.   
  87.   if (cons(MPPH_true,MPPH_nil,MPPH_context_stack) == FAIL) {
  88.  
  89. DBG_FAIL(fprintf(dbg,"FAIL: Unable to cons base of context stack"));
  90.     return FAIL;
  91.   }
  92.  
  93.   /* OF_destroy(MPP_context_stack) */
  94.  
  95. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  96.   return SUCCESS;
  97. }
  98.  
  99. /*----------------------------------------------------------------------------*
  100.  * Function   : mp_main
  101.  *
  102.  * Parameters : int operator_id:    Constant identifier for desired op
  103.  *         int no_of_args:        Number of arguments
  104.  *        object MPP_arg1:    MasPar Plural Objects for arguments
  105.  *        object MPP_arg2:    (At this time a maximum of two)
  106.  *        object MPP_arg3:    (Now a maximum of three)
  107.  *
  108.  * Description: Big switch statement to apply the desired function to the
  109.  *        given arguments and return the result
  110.  *
  111.  * Result     : object MPP_result;
  112.  *---------------------------------------------------------------------------*/
  113.  
  114. #ifdef __STDC__
  115.  
  116. visible object mp_main( int operator_id, int no_of_args,
  117.               object MPP_arg1, object MPP_arg2, object MPP_arg3 )
  118.  
  119. #else
  120.  
  121. visible object mp_main( operator_id, no_of_args, 
  122.               MPP_arg1, MPP_arg2, MPP_arg3 )
  123.  
  124. int operator_id;
  125. int no_of_args;
  126. object MPP_arg1;
  127. object MPP_arg3;
  128. object MPP_arg2;
  129.  
  130. #endif
  131.  
  132. {
  133.   object MPP_result;
  134.   MP_PluralHeap MPPH_arg1;    /* C-stack allocate Plural Heap */
  135.   MP_PluralHeap MPPH_arg2;    /* objects, handles on the heap */
  136.   MP_PluralHeap MPPH_result;    /* space of each operand    */
  137.   MP_PluralHeap MPPH_arg3;
  138.   MP_PluralHeap MPPH_context;
  139.   MP_PluralHeap MPPH_bool;
  140.   plural natural bool;
  141.   int result_status;
  142.   int transferred;
  143. DBG_CALL("mp_main");
  144. DBG_ARGS(fprintf(dbg,"operator_id=%d, no_of_args=%d, MPP_arg1=%04x, MPP_arg2=%04x",operator_id,no_of_args,MPP_arg1,MPP_arg2));
  145.  
  146.   /* If more than one argument check they are conformant */
  147.  
  148.   if (no_of_args >= 2) {
  149.  
  150.     if (!OF_conformant_p(MPP_arg1,MPP_arg2)) {
  151.  
  152. DBG_EXIT(fprintf(dbg,"FAIL: plurals are not conformant"));
  153.       return FAIL;
  154.     }
  155.   }
  156.  
  157.   /* Create new Plural for the result */
  158.  
  159.   if ((MPP_result = alloc_plural( MPP_arg1, 0 )) == FAIL) {
  160.  
  161. DBG_EXIT(fprintf(dbg,"FAIL: unable to allocate plural"));
  162.     return FAIL;
  163.   }
  164.  
  165.   OA_to_offsets(MPPH_context) = &context_stack;
  166. /*print(MPPH_context,(plural int) 0);
  167. fprintf(stdout,"#P( ");
  168. p_fprintf(stdout,"%s ",scratch);
  169. fprintf(stdout,")\n");*/
  170.  
  171.   OA_to_offsets(MPPH_bool) = &bool;
  172.  
  173.   if (car(MPPH_context, MPPH_bool) == FAIL) {
  174.    
  175. DBG_FAIL(fprintf(dbg,"FAIL: Unable to take car of context stack"));
  176.     return FAIL;
  177.   }
  178.  
  179.  
  180.  
  181.   if (no_of_args >= 1) MPP_2_MPPH(MPPH_arg1,MPP_arg1);
  182.   if (no_of_args >= 2) MPP_2_MPPH(MPPH_arg2,MPP_arg2);
  183.   if (no_of_args >= 3) MPP_2_MPPH(MPPH_arg3,MPP_arg3);
  184.   MPP_2_MPPH(MPPH_result,MPP_result);
  185.  
  186.   scratch[(plural int) 0] = (plural natural) NULL;
  187.  
  188.   if (/**(plural int *plural) OA_data(MPPH_bool) == */1) {
  189.   
  190.   OF_on_plural(MPP_arg1) {
  191.  
  192.     switch (operator_id) {
  193.  
  194.     case MP_MAKE_INTEGER :
  195.  
  196.       result_status = make_integer( MPPH_arg1 );
  197. fprintf(dbg,"object_type = %x\n",MPPH_result->Generic.object_type);
  198.       OF_destroy(MPP_result);
  199.       MPP_result = MPP_arg1;
  200.       break;
  201.  
  202.     case MP_PLUS :
  203.  
  204.       result_status = plus( MPPH_arg1, MPPH_arg2, MPPH_result );
  205.       break;
  206.  
  207.     case MP_LESS_THAN :
  208.  
  209.       result_status = less_than( MPPH_arg1, MPPH_arg2, MPPH_result );
  210.       break;
  211.  
  212.     case MP_MP_CONS :
  213.       
  214.       result_status = cons( MPPH_arg1, MPPH_arg2, MPPH_result );
  215.       break;
  216.  
  217.     case MP_CAR :
  218.  
  219.       result_status = car( MPPH_arg1, MPPH_result );
  220.       break;
  221.       
  222.     case MP_CDR :
  223.  
  224.       result_status = cdr( MPPH_arg1, MPPH_result );
  225.       break;
  226.       
  227.     case MP_RPLAC_A :
  228.  
  229.       result_status = rplac_a( MPPH_arg1, MPPH_arg2 );
  230.       OF_destroy(MPP_result);
  231.       MPP_result = MPP_arg1;
  232.       break;
  233.  
  234.     case MP_RPLAC_D :
  235.  
  236.       result_status = rplac_d( MPPH_arg1, MPPH_arg2 );
  237.       OF_destroy(MPP_result);
  238.       MPP_result = MPP_arg1;
  239.       break;
  240.  
  241.     case MP_PRINT :
  242.  
  243.       scratch[(plural int) 0] = (plural int) NULL;
  244.       print( MPPH_arg1,(plural int) 0 ); 
  245. /*      fprintf(stdout, "#P( ");
  246.       p_fprintf(stdout, "%s ", scratch);
  247.       fprintf(stdout, ")\n");
  248. */      OF_destroy(MPP_result);
  249. /*      transferred = blockOut(scratch,MPP_arg2,0,0,nxproc,nyproc,64);
  250. */      MPP_result = MPP_arg1;
  251.       result_status = SUCCESS;
  252.       break;
  253.  
  254.     case MP_ASSIGN :
  255.       
  256.       /* Here arg2 is not an object but represents an integer */
  257.  
  258.       *(plural int *plural)OA_data(MPPH_arg1) = (plural int) MPP_arg2;
  259.       OF_destroy(MPP_result);
  260.       MPP_result=MPP_arg1;
  261.       result_status = SUCCESS;
  262.       break;
  263.     
  264.     case MP_MAKE_MP_VECTOR :
  265.  
  266.      /*  In this case, argument two is not an object (i.e. address) but
  267.       *  a 32 bit integer indicating the size of vector to be allocated.
  268.       */
  269.  
  270.       make_vector( (plural int) MPP_arg2, MPPH_arg1 );
  271.       OF_destroy(MPP_result);
  272.       MPP_result = MPP_arg1;
  273.       break;
  274.  
  275.     case MP_MP_VECTOR_SET :
  276.  
  277.       /* Check argument 2 are integers */
  278.  
  279.       if (globalor(OA_info(MPPH_arg2) != INTEGER)) {
  280.  
  281. DBG_EXIT(fprintf(dbg,"FAIL: Some of the indexes are not integers"));
  282.         result_status = FAIL;
  283.       }
  284.       else {
  285.     
  286.     result_status = vector_set( MPPH_arg1, 
  287.                     *(plural int *plural) OA_data(MPPH_arg2), 
  288.                     MPPH_arg3);
  289.     OF_destroy(MPP_result);
  290.     MPP_result = MPP_arg1;
  291.       }
  292.       break;
  293.  
  294.     case MP_MP_VECTOR_REF :
  295.  
  296.       /* Check argument 2 are integers */
  297.  
  298.       if (globalor(OA_info(MPPH_arg2) != INTEGER)) {
  299.  
  300. DBG_EXIT(fprintf(dbg,"FAIL: Some of the indexes are not integers"));
  301.         result_status = FAIL;
  302.       }
  303.       else {
  304.       
  305.     result_status = vector_ref( MPPH_arg1, 
  306.                     *(plural int *plural) OA_data(MPPH_arg2), 
  307.                     MPPH_result);
  308.       }
  309.       break;
  310.  
  311.     case MP_IF :
  312.  
  313.       OA_to_offsets(MPPH_result) = &context_stack;
  314.       result_status = mp_if( MPPH_arg1, MPPH_result );
  315.       break;
  316.  
  317.     default:
  318.       
  319.       result_status = FAIL;
  320.     }
  321.   }
  322.   }
  323.     
  324.   if (result_status == FAIL) {
  325.  
  326.     OF_destroy(MPP_result);
  327. DBG_EXIT(fprintf(dbg,"FAIL: in op or unknown op"));
  328.     return FAIL;
  329.   }
  330.  
  331.   if (operator_id = MP_PRINT) return scratch;
  332.  
  333. DBG_EXIT(fprintf(dbg,"%04x",MPP_result));
  334.   return MPP_result;
  335. }
  336.  
  337.  
  338. /*----------------------------------------------------------------------------*
  339.  * Function   : load_plural
  340.  *
  341.  * Parameters : object MPP_into:    MasPar Plural Object to load data into
  342.  *        void *fe_start:        Front End address of where data starts
  343.  *        int size:        How much is to go onto each element
  344.  *
  345.  * Description:    Load the given plural with data copied from the front end.
  346.  *        The same quantity of data is to be loaded onto each PE. The
  347.  *        first PE takes its data from fe_start, the next PE from 
  348.  *        fe_start + size and so on. The data is copied into scratch
  349.  *        before being copied to its destination. When things lagere
  350.  *        tahn the scratch memory are loaded the load is done in several 
  351.  *        passes.
  352.  *
  353.  * Result     : int:    SUCCESS - all went well
  354.  *          :        FAIL    - something amiss - shouldn't be memory as this
  355.  *                  will have been allocated before calling load.
  356.  *---------------------------------------------------------------------------*/
  357.  
  358. #ifdef __STDC__
  359.  
  360. visible int load_plural( object MPP_into, char *fe_start, int size )
  361.  
  362. #else
  363.  
  364. visible int load_plural( MPP_into, fe_start, size )
  365.  
  366. object MPP_into;
  367. char *fe_start;
  368. int size;
  369.  
  370. #endif
  371.  
  372. {
  373.   char *fe_start2, *fe_start3;
  374.   plural char *plural copy_to;
  375.   plural heap_header headers;
  376.   int size_to_copy;
  377.   int x_rec1;                   /* x coord of first element */
  378.   int lx_rec1;                  /* width of first rectangle */
  379.   int y_rec1;                   /* y coord of first element */
  380.   int ly_rec2;                  /* height of rectangle2 in  */
  381.   int lx_rec3;            /* width of last rectangle  */
  382.   int processors_read = 0;      /* No of processors read after each rectangle*/
  383.   int result;
  384.  
  385. DBG_CALL("load_plural");
  386. DBG_ARGS(fprintf(dbg,"MPP_into=%lx, fe_start=%lx, size=%d",
  387.               MPP_into,fe_start,size));
  388.  
  389.   OF_on_plural(MPP_into) {
  390.  
  391.     /* Check the load is possible                 */
  392.     /* Does the plural have space allocated to it */
  393.  
  394.     if (globalor(OF_plural_cmpt(MPP_into) == NIL)) {
  395.  
  396. DBG_EXIT(fprintf(dbg,"FAIL: Some elements have no memory"));
  397.       return FAIL;
  398.     }
  399.  
  400.     /* The plural memory hasn't been inadvertently freed has it? */
  401.  
  402.     headers = OF_header_cmpt(MPP_into);
  403.     
  404.     if (globalor(HH_free(headers) == TRUE)) {
  405.  
  406. DBG_EXIT(fprintf(dbg,"FAIL: Some elements heap space has been freed"));
  407.       return FAIL;
  408.     }
  409.  
  410.     /* The plural heap space is all big enough isn't it   ?        */
  411.  
  412.     if (globalor(((HH_space(headers) * 4) < size )) {
  413.  
  414. DBG_EXIT(fprintf(dbg,"FAIL: Some elements have insufficient space"));
  415.       return FAIL;
  416.  
  417.     }
  418.  
  419.     /* Okay " Al est esfertag " */ 
  420.  
  421.     /* This next part is a hack: identify at most three rectangles that */
  422.     /* describe the plurals on the array. We allocate sequentially -    */
  423.     /* it works as though its a grid - this has serious implications    */
  424.     /* for the alocation algorithm.                                     */
  425.  
  426.     processors_read = 0;
  427.     x_rec1 = proc[(int) OA_start(MPP_into)].ixproc;
  428.     y_rec1 = proc[(int) OA_start(MPP_into)].iyproc;
  429.     if ((x_rec1 + OA_length(MPP_into)) < nxproc) 
  430.       lx_rec1 = OA_length(MPP_into) ;
  431.     else
  432.       lx_rec1 = nxproc - x_rec1;
  433.     processors_read = lx_rec1;
  434.     fe_start2 = processors_read * size + fe_start;
  435.     ly_rec2 = (OA_length(MPP_into) - processors_read) / nxproc;
  436.     processors_read = processors_read + ly_rec2 * nxproc;
  437.     fe_start3 = fe_start + processors_read * size;
  438.     lx_rec3 = OA_length(MPP_into) - processors_read;
  439.  
  440.     copy_to = OF_data_cmpt(MPP_into);
  441.  
  442. DEBUG(fprintf(dbg,"x_rec1=%d, y_rec1 = %d\n",x_rec1,y_rec1));
  443. DEBUG(fprintf(dbg,"lx_rec1=%d, ly_rec2=%d\n",lx_rec1,ly_rec2));
  444. DEBUG(fprintf(dbg,"lx_rec3=%d\n",lx_rec3));
  445. DEBUG(fprintf(dbg,"fe_start2=%lx, fe_start3=%lx\n",fe_start2,fe_start3));
  446.  
  447.     for ( ; size > 0; size = size - size_to_copy) {
  448.       
  449.       if (size > SCRATCH_MEMORY_SIZE) size_to_copy = SCRATCH_MEMORY_SIZE;
  450.       else size_to_copy = size;
  451.  
  452.       result = blockIn(fe_start,scratch,x_rec1,y_rec1,lx_rec1,1,size_to_copy);
  453. DEBUG(fprintf(dbg,"Number of bytes copied = %d\n",result));
  454.  
  455.       if (result == -1) {
  456. DBG_EXIT(fprintf(dbg,"FAIL: for rectangle1 (%d,%d)(%d,1)",x_rec1,y_rec1,lx_rec1));
  457.     return FAIL;
  458.       }
  459.  
  460.       if (ly_rec2 > 0) {
  461.  
  462.     result = blockIn(fe_start2,
  463.              scratch,0,y_rec1+1,nxproc,ly_rec2,size_to_copy);
  464.  
  465.       if (result == -1) {
  466. DBG_EXIT(fprintf(dbg,"FAIL: for rectangle2 (0,%d)(%d,%d)",y_rec1+1,nxproc,ly_rec2));
  467.       return FAIL;
  468.     }
  469.       }
  470.  
  471.       if (lx_rec3 > 0) {
  472.  
  473.     result = blockIn(fe_start3,
  474.                  scratch,0,y_rec1+1+ly_rec2,lx_rec3,1,size_to_copy);
  475.  
  476.     if (result == -1) {
  477. DBG_EXIT(fprintf(dbg,"FAIL: for rectangle3 (0,%d)(%d,1)",y_rec1+1+ly_rec2,lx_rec3));
  478.        return FAIL;
  479.     }
  480.       }
  481.       pp_memcpy(copy_to, (plural char *plural) scratch, (plural int) size_to_copy );
  482.       copy_to = copy_to + size_to_copy;
  483.     }
  484.   }
  485.  
  486. DEBUG(p_dbg_print("scratch[0]",0,16,"%02x ",(plural natural) scratch[0]));
  487. DEBUG(p_dbg_print("scratch[1]",0,16,"%02x ",(plural natural) scratch[1]));
  488. DEBUG(p_dbg_print("scratch[2]",0,16,"%02x ",(plural natural) scratch[2]));
  489. DEBUG(p_dbg_print("scratch[3]",0,16,"%02x ",(plural natural) scratch[3]));
  490.  
  491. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  492.   return SUCCESS;
  493. }
  494.  
  495.  
  496.  
  497.